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Dynamic data structure 


Dynamic data structure 
list,queue,stack: ةذںÛ تنقسم الى‎ 


في هذا الموضوع سوف نتعامل مع الموشرات ۲ع)مذمم بترتيب غير ثابت 

اي ترتبط بترتيب حركي بحيث ان هذة المؤشرات تغير ترتيب البيانات عن طريق تغير وجهة 

الور ات فسوف کو ضح تعن ا ل داك انا سرک في لامكال و انی مک ت 
غل ای له بدك اناا ر عل ان فی الس تارب اجه مر قرات کا فی الانکل رم 

والسى<- . 


المؤشرات هي من انواع البيانات البسيطة والمتغيرات المؤشرية د تستخدم للاشارة الى متغيرات من 
انواع اخرى وهذة تسمى المتغيرات المؤشر عليها . 


Stack:‏ لمکدس) 


stack(lifo)-last 1n first out 
الأضافة .و الحذف من النهاة‎ 


النهاية 3 
5 
البداية 
11 
فاذا ارادنا نضيف العدد 6 فاننا نضيفة بعد العدد 3 
النهاية 6 
3 
5 
البداية 
11 


فاذا ارادتا ان نحذف عنصر فانة سيكون من البداية وهو العدد 6 


مثال على الباسكال 


program Stek2; 

uses crt; 

const 

n=4; 

var 
x:1nteger; 

a:array[1..n] of integer; 

1:integer; 
e:integer; 


Procedure Add; 
var 
e:1nteger; 
begin 


1=]; 
writeln(STEK free’); 
repeat 
x:i=x+1; 
writelnf ENTER lement Steka - ',1); 
readln(e); 
a[il:ize; 
1=1+1; 
until x=n; 


النهاية 3 
5 
البداية 
11 


writeln(Stek Full"); 
end; 


Procedure Show; 
begin 
writeln (HHH; 
for 1:=x downto 1 do 
begin 
writeln(a[1]); 
end; 


begin 


repeat 
writeln( delete '); 
readkey; 
delt; 
writeln(position ',x); 
show; 
1f I=x then break; 
131+1; 
until i=n; 
writeln(Stek free’); 
readln; 
readln; 
end. 


2 G:lpascall TPIBIMITPX. EXE 


STER Free 
ENTER lement 


11 

ENTER lement 
ENTER lement 
ENTER lement 
tek Full 


Sr hh 


position 3‏ 
و اي ي ڪه و ڪي و و 

3 

1 
1L1 

dle lete 


مثال اخر على السي 


#ınclude <stdio.h> 
#ınclude <stdlib.h> 
#include <string.h> 
#ınclude <conio.h> 


/* in pascal 
type 
TMY=^ tmy; 
_tmy=record 
name :char; 
age:integer; 
next:TMY; 
end; 

1 
typedef struct TMy TMy; 
struct _TMy 
char* Name; 
int Age; 
TMy * Next; 


1 
void show( TMy Db ) 


1 
printf("Name: %s, age: Yod\n", b.Name, b.Age); 


TMy* Top; 
void add stack(char* s, int a) 


TMy *d; 

d = (TMy *) malloc (sizeof(TMy)); 
(*d).Name = strdup(s); 
(*d).Age = a; 

(*d).Next = Top; 

Top = d; 


vold show_stack() 


TMy *tmp = Top; 
while (tmp != NULL) 


show(*tmp); 
tmp = (*tmp).Next; 


vold main) 
cirscr)0; 
char st[80]; 


int age; 
for(int 1=0; 1<3; 1F+) 


flushall); 


puts("Enter name: "); 
gets(st); 
puts("Enter age: "); 
scanf("%od", &age); 
add stack(st, age); 
printf("In base:\n"); 
show _stack(); 


cv Turbo C++ IDE 


5: wadah, age: 2b 


5 adilson, age: 2b 
5: aþdulmajed, age: 2Û 


()Queue)FIF0(الترتیب)‏ 
first In first out‏ 
الاضافة في البداية والحذف من النهاية 


3 
5 
11 
فاذا ارادنا اضافة العنصر 6 فاننا سنضيفة شئ البداية قبل 11 
3 
5 
11 
6 
واذا ارادنا الحذف فانة سیتم من النهاية يعني العدد 3 
5 
11 
6 
مثال غلى الباسكال 
uses crt;‏ 
type‏ 


tip  =^element; 
element = record 
inf : Integer; 
link : tip; 
end; 
var 


begQ,endQ,p : tip; 
kon:tip; 
v,1,n : integer; 


procedure cozidat(v1:1nteger); 
var p : tip; 
begin 
new(p); 
p^.inf:=v1; 
p^.link:=n1l; 


if begQ = nil then 
begin begQ := p; {dababit tolka adin element} 
endq:=p; {dababit cklka mi xatem} 
end else 
begin  endQ^ .link:=p; 
endQ:=p; end; 
end; 


procedure delete(var v1:1nteger); 
var Mm:tip; {p:tip} 
begin 
1 v1:=begQ^.inf; 
p:=begQ; 
begQ:=begQ^.link; 
if begQ = nil then 
endQ:= nil; 
dispose(p); } 
v1:=begQ^.1nf; 
m:=begq; 
begq:=begq^.link; 


dispose(m); 
end; 


option : byte; 
key : integer; 
v1: integer; 
Begin 
cirscr; 
begQ:=n1l; 
endQ:=nil; 
write(Enter n = '); 
{ readln(n); 


for 1:=1 to n do 
cozidat(); 
repeat 


writeln(N-',1,' Enter more element:"); 

writeln(N-',2,' delete one element from the end of querre:"); 
writeln(N-',3,' show querre:'"); 

writeln(N-',0,' exit :"); 


writeln( Enter a choice:"); 
readlin(option); 


case option of 
1: begin 
writeln( Enter more element:"); 
readln(key); 
cozidat(key); 
end; 
2: begin 
write(Delete element in queue : '); 
Delete(v1);writeln( that is element : ',v1); 
end; 
3: begin 
kon:=begQ; 


writeln('elements 1n queue : '); 
while kon<>nil do 
begin 
writeln(kon^.1Inf,' '); 
kon:=kon^.link; 
end; 
writeln; 
end; 
0: exit; 


end; { of case } 
until false; 
readkey; 
End. 


2| G:\pascall TPIBIMTPA. EXE 


NH-1 Enter more element : 

H-Z delete one element from the end of querre: 
NH-3 shou queFFre 2 

N- exit : 

Enter a choice : 


Enter more element : 

11 

NH-1 Enter more element : 

H-Z delete one element from the end of querre : 
NH-3 shou queFFE : 

NH- exit : 


Enter a choice: 
3 


elements in {UeEUE : 


3 
11 


H-1 Enter more element : 

H-Z delete one element from the end of querre : 
H-3 shou querFre 

N-H exit : 

Enter a choice: 


N-Z delete one element from the end of querre 
N-3 show querFre 

N-H exit : 

Enter a choice: 


Enter more Element : 


N-1 Enter more element : 

N-Z delete one element from the end of querre 3 
N-3 show querFre : 

N-H exit : 

Enter a choice: 

3 

e in qUEUME 5 


3 
11 
Û 


N-1 Enter more element : 

N-Z delete one element from the end of querre : 
N-3 show querFre 

N-H exit : 

Enter a choice: 


N-1 Enter more element x 

NH-Z delete one element From the end of querre : 
N-3 shou querre 2 

N-H exit : 

a choice:‏ ا 


De lete element in queue 5 that is element 5 3 
H-1 Enter more element : 

NH-Z delete one element from the end of querre : 
HNH-3 show querre 2 

N-H exit : 

Enter a choice: 


elements in queue ؟:‎ 


11 
Û 


H-1 Enter more element : 
N-Z delete one element from the end of qgquerre : 
H-3 show querre : 
N-H exit : 
a choice: 


مثال اخر على السي 
#ınclude <stdio.h>‏ 
#include <string.h>‏ 
#ınclude <conio.h>‏ 
#ınclude <stdlib.h>‏ 


typedef struct ozer OZER; 
Struct _Ozer 
{ 
char*name; 
int age; 
OZER * next; 
ل‎ 


OZER *BegPtr, *EndPtr; 
vold add(char* name, int age) 


( 
OZER *tmp; 
tmp = (OZER*) malloc (sizeof(OZER)); 
tmp->name = strdup(name); 
tmp->age = age; 
tmp->next = NULL; 


if (BegPtr == NULL) { 
// queue 1s empty 
BegPtr = EndPtr = tmp); 
} else { 
// queue 1s not empty 
EndPtr->next = tmp; 
EndPtr = tmp; 


void show() 


OZER *tmp; 
tmp = BegPtr; 
while (tmp != NULL) { 
printf("Element:\n Name:='%os\n Age:="%od\n", tmp->name, tmp->age); 
tmp = tmp-2next; 


vold main() 


char name[ 80]; 
int age; 
int 1; 
for (=0; 1<3; 1+) { 
printf("\nEnter name: "); 
flushall); 
gets(name); 
printf("\nEnter age: "); 
scanf("%od", &age); 
add(name, age); 


showÛ0; 
getch(; 


ox Turbo C++ IDE 


Enter name abdu Ima jed 
" aE: Zb 
“ name: adilson 
age 2b 
" name: wadah 


Enter age: 25 
Element : 
Hame 5 =" aþdu Imajed" 
Aqe:=" 2b" 
Element 
Hame 5 =" adi lson’" 
Age =" 2b" 
Element 3 
ELE e E 
Age: =" 5 


iء))مئاوقلا(‎ 


الاضافة في اي مكان مسموح في البداية اوفي الوسط او في النهاية اختيارية 


11 


فاذا اردت اضافة العدد 6 يمكنك اضافتها 
کیفما ترید قبل ال 5 او بعدها او قبل اال 11 
الف کلف ق اع من مم د ا ا رف رار نے اا اکا 


امثلة في الباسكال 


مثال 1 
اعمل generator‏ للعدد واضافتة في القائمة فاذا كان هذا العدد موجود في القائمة 
فاحذفة من القائمة واذا كان غير موجود اضيفة في القائمة. 
cirscr;‏ 
add(2);‏ 
add(10);‏ 
add(5);‏ 


add(1); 
add(7); 
add(11); 


writeln ^); 

show; 

لاحظ هذه الدالة التي نفحص فيما اذا كان العدد موجود او لا فنحن هنا// ٤×)6(;‏ 4ه 

استدعيناها // 
لاحظ هنا سيتم اضافة العدد 6 لانة لا يوجد ضمن القائمة 2,10,5,1,7,11؟ 
لکن اذا كان addEx(10);‏ طبعا سیتم حذفة من القائمة لانة يوجد في القائمة 

writeln '); 

show; 


البرنامج 


uses crt; 
type 
TIr=?r; 
r = record 
1 : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 


function find(i : Integer) : Tr; 


var 
Ppp, ppl : Tr; 
begin 
ppl := nil; 
pp := begptr; 
while pp <> nil do 
begin 


if pp^.1 > 1 then 


break; 


ppl := pp; 
pp := pp^.next; 
end; 
find := ppl; 
end; 


procedure add( 1 : integer ); 
var 
Ppp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
pp! := find(D); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 

Ppp, ppl : Tr; 
begin 

pp := begptr; 

ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 
Var 


pp, ppl, pp2 : Tr; 


i : integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
Pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 
pp2 := prev(pp1); 
pp2^.next := nil; 
dispose(endptr); 
endptr := pp2; 
end 
else 
begin 
pp2 := prev(pp1); 
ppl := pp1^.next; 
dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 
end; 


function find el(i : integer) : integer; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
find el := 0; 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pp^.1 = 1 then 
begin 
find el := ind; 
break; 
end; 
ppl := pp; 
pp := pp^.next; 
end; 
end; 


procedure addEx( : integer); 
var 
ind : integer; 
begin 
ind := find el(); 
if ind = 0 then 
add) 
else 
del(ind); 
end; 


begin 
cirscr; 


add(2); 
add(10); 
add(5); 
add(1); 
add(7); 
add(11); 
writeln '); 
show; 
addEx(6); 
writeln ^); 
show; 

end. 


8 BSE 


لكن اذا كان ;(48×)10 1ه طبعا سيتم حذفة من القائمة لانة يوجد في القائمة 


2 Ek 


المثال الثاني 


القائمة معطاة اوجد العنصر المتوسط من عناصر القائمة واوجد اكبر عنصر في الجهة اليسرى 
للعنصر المتوسط واكبر عنصر في الجهة اليمنى للعنصر المتوسط . 


البرنامج 


uses crt; 
type 
TIr=?^y; 
r = record 
1 : integer; 


next : TT; 
end; 
var 
1 : integer; 
begptr, endptr, pp : Tr; 


function find(i : Integer) : Tr; 
var 
Pp, ppl : Tr; 
begin 
pp1 := nil; 
pp := begptr; 
while pp <> nil do 
begin 
if pp^.1 > 1 then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find := pp1; 
end; 


procedure add( 1 : integer ); 
var 

pp, ppl : Tr; 
begin 

new (pp); 

pp^.1 := 1; 

pp^.next := nil; 

if endptr = nil then 


begin 
endptr := pp; 
begptr := pp; 
end 
else 


begin 


ppl := endptr; 
{ PpplI := find); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else} 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


var 
pp, ppl : Tr; 
begin 
pp := begptr; 


ppl := nil; 


while pp <> nil do 


begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
Pp, ppl, pp2 : Ir; 
1 : integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
pp := pp^.next; 
if 1 = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
1f pp1 = endptr then 
begin 


pp2 := prev(pp1); 


pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(ppl);} 
end; 


end; 


function find el(i : integer) : integer; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
find el := 0; 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pp^.1 = 1 then 
begin 
find el := ind; 
break; 
end; 
pp! := pp; 
pp := pp^.next; 


end; 
end; 


procedure addEx( : integer); 
var 
ind : integer; 
begin 
ind := find el(); 
if ind = 0 then 
add) 
else 
del(ind); 
end; 


procedure middel and max; 
var 
pp : I1; 
ind, summ, count, mid : integer; 
dx, 1 mid : integer; 
halfcount : integer; 
emax, Imax, rmax : integer; 
begin 
summ := 0; 
count := 0; 
ind := 0; 
pp := begptr; 
while pp <> nil do 
begin 
summ := summ + pp^.1; 
inc(count); 
pp := pp^.next; 
end; 
mid := summ div count; 


pp := begptr; 
dx := begptr^.1; 


1 halfcount := count / 2;} 
Imax := 0; 
rmax := 0; 
while pp <> nil do 
begin 
inc(ind); 
if abs(mid - pp^.1) < dx then 
begin 
dx := mid - pp^.1; 
emax := pp^.1; 
1 mid := ind; 
end; 
if (ind < (count/2)) then 
begin 
if Imax < pp^.1i then Imax := pp^.1; 
end 
else 
begin 
if rmax < pp^.1 then rmax := pp^.1; 
end; 
pp := pp^.next; 
end; 
writeln('Motawaset element:',emax); 
writeln( Max left element:',lImax); 
writeln( Max right element:',rmax); 
end; 


begin 
cirscr; 
add(2); 
add(10); 
add(5); 
add(1); 
add(7); 
add(11); 
writeln ^); 


show; 


middel and max; 
{ writelnd D; 


E 


show; } 
end. 


Max Fight element 511 


المثال الثالث 


القائمة معطاة اوجد اول عنصر اقل من الصفر ومن تم اعمل عملية ترتيب للعناصر 
بعد هذا العنصر الذي اقل من الصفر . 


البرنامج 


uses crt; 
type 
TIr=?r; 
r = record 


i : integer; 


next : TT; 


end; 
var 
1 : integer; 
begptr, endptr, pp : Tr; 


function find(i : Integer) : Tr; 
var 
Pp, ppl : Tr; 
begin 
ppl := nil; 
pp := begptr; 
while pp <> nil do 
begin 
if pp^.1 > 1 then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find := pp1; 
end; 


function find place(p!l : Integer) : Tr; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 


end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
{ ppl := endptr; { 
ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : Ir; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 

Ppp, ppl : Tr; 
begin 

pp := begptr; 

ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 
Var 


pp, ppl, pp2 : Tr; 
1 : integer; 


begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1i:=1+1; 
ppl := pp; 
Pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 
pp2 := prev(pp1); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(ppl);} 


end; 
end; 


function find el(i : integer) : integer; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
find el := 0; 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pp^.1 = 1 then 
begin 
find el := ind; 
break; 
end; 
ppl := pp; 
pp := pp^.next; 
end; 
end; 


procedure addEx(i : integer); 
var 
ind : integer; 
begin 
ind := find el(); 
if ind = 0 then 
add) 
else 
del(ind); 
end; 


procedure middel and del; 
var 


pp : Ir; 
1, max, i max, ind : integer; 
begin 
pp := begptr; 
max := 0; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if (max < pp^.1) then 
begin 
max := pp^.1; 
1 _ max := ind; 
end; 
pp := pp^.next; 
end; 
del(i max-1); 
for 1:=1 max to 1 max+5 do 
del); 
end; 


procedure sort; 
var 
st:string; 
i,k,count:1inte ger; 
pp,p,p1,p2: Tr; 
tmpBeg : Tr; 
find : boolean; 
begin 


find := false; 
pp := begptr; 
while pp <> nil do 
begin 

if pp^.1 < 0 then 


begin 


find := true; 
break; 
end; 
pp := pp^.next; 
end; 


1f not find then exit; 
tmpBeg := begptr; 
begptr := pp; fafter sorting we will delete this dummy element} 
p:=begptr^.next; 
count:=O0; 
while (p<>nil) do 
begin 
inc(count); 
p:=p^.next; 
end; 


for 1:=count downto 2 do 
begin 
k:=]1; 
p:=begptr; 
while (k<1) do 
begin 
pl:=p^.next; 
p2:=p1^.next; 
if (p1^.1 > p2^.1) then 
begin 
p1^.next:=p2^.next; 
p2^.next:=pl; 
p^.next:=p2; 
1f (p1^.next=nil) then 
endptr:=p1; 
end; 
p:=p^.next; 
inc(k); 
end; 


end; 
begptr := tmpBeg; 
end; 


begin 
cirscr; 
add(2,1); 
add(-1,2); 
add(10,3); 
add(5,3); 
add(7,5); 
add(11,6); 
add(100,3); 
writeln ’; 
show; 
SOrt; 
writeln ’; 
show; 

end. 
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المثال الرابع 


القائمة معطا اوج أك تضكر فى القاقمة ون ك اة أغعمل حذف لخمسة عذاصر هذا 


البرنامج 


uses crt; 
type 
TIr=?^r; 
r = record 
1 : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 


procedure add( i : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
ppl := endptr; 


{ Ppl := find); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else} 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


var 
pp, ppl : Tr; 
begin 
pp := begptr; 


ppl := nil; 


while pp <> nil do 


begin 
1f pp^.next = p then 
begin 
ppl := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
pp! := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 


pp2 := prev(ppl); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 
pp2 := prev(ppl1); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 


end; 


procedure middel and del; 
var 
pp : I1; 
1, max, 1 max, Ind : integer; 
begin 
pp := begptr; 
max := 0; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if (max < pp^.1) then 
begin 
max := pp^.1; 
1 _ max := ind; 
end; 
pp := pp^.next; 
end; 


write('max:', max); 


for 1:=1 max to 1 max+5 do 
del); 
end; 


begin 
cirscr; 
add(2); 
add(10); 
add(5); 
add(1); 
add(7); 
add(11); 
add(2); 
add(3); 
add(1); 
add(6); 
add(4); 
add(1); 
add(3); 
add(9); 
writeln; 
show; 
middel and del; 
writeln; 
show; 

end. 


في البداية اوجدنا العنصر الاكبر كما في الجاريتم 
if (max < pp^.1) then‏ 
begin‏ 
اوجدنا هنا العنصر الاكبر ;1.^مم =: axہآ‏ 
هنااوجدناال 10ازومم حق العنصر الاكبر ;لما =: xھ_‏ 1 
end;‏ 
من اجل ان يشير الى العنصر التالي ;)×ع۸. ٣مم‏ =: مم 
end;‏ 


اطا الفتصر الاكر 


write('max:", max); 


ومن تم عملنا الحلقة تبدا من مكان العنصر الاكبر الى 
مكان العنصر الاکبر م t10زوsمم‏ +5 


for 1:=1 max to 1 max+5 do 
delQ0); من هنا نستدعي دالة الحذف الل کتبناها اعلی‎ 
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المثال الخامس 


القائمة معطاة اوجدالعنصر الاكبر ومن ثم احذفة؟ 
البرنامج 
uses crt;‏ 
type‏ 
Tr=?r;‏ 
r = record‏ 
i : integer;‏ 
next : TT;‏ 
end;‏ 
var‏ 
integer;‏ : 1 


begptr, endptr, pp : Tr; 


procedure add( i : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
ppl := endptr; 
{ Ppl := find); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else} 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 
var 


pp : Ir; 


begin 
pp := begptr; 


while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 

pp, ppl : Tr; 
begin 

pp := begptr; 

ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 
var 

pp, ppl, pp2 : Tr; 

1 : Integer; 
begin 

pp := begptr; 

1:= 0; 


while pp <> nil do 


begin 
1i:=1+1; 
pp! := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 


pp2 := prev(pp1); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(pp1); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(ppl);} 
end; 


end; 


procedure middel and del; 
var 
pp : Tr; 


1, max, i max, ind : integer; 
begin 
pp := begptr; 
max := 0; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if (max < pp^.1) then 
begin 
max := pp^.1; 
1 _ max := ind; 
end; 
pp := pp^.next; 
end; 


writeln(max:=',max); 
delû max); 


end; 


begin 
cirscr; 
add(2); 
add(10); 
add(5); 
add(1); 
add(7); 
add(11); 
writeln ^); 
show; 
middel and del; 
writeln '); 
show; 

end. 


في البداية اوجدنا العنصر الاكبر كما في الجاريتم 
if (max < pp^.1) then‏ 
begin‏ 
اوجدنا هنا العنصر الاكبر ;1.٣^مم‏ =: ax‏ 
هنااوجدناال 10ازومم حق العنصر الاكبر ;لما =: xھ٣_‏ 1 
end;‏ 
من اجل ان يشير الى العنصر التالي ;ا×عہ.*^مم =: مم 
end;‏ 


write('max:', max); 
لع1)1_دa×(;ربكالا ومن ثم نحذف ال 10۸ازومم حق العنصر‎ 
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المثال السادس 
القائمة معطاة اوجد العنصر ومن ثم احذفة من القائمة؟ 
البرنامج 


uses crt; 
type 
Tr=?^y; 
r = record 
1 : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 


procedure add( 1 : integer ); 
var 

pp, ppl : Tr; 
begin 

new (pp); 

pp^.1 := 1; 

pp^.next := nil; 

if endptr = nil then 


begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
ppl := endptr; 
begin 
if pp1^.next = nil then 
endptr := pp; 


pp^.next := pp1^.next; 


pp1^.next := pp; 
end; 


end; 
end; 


procedure show; 


var 
pp : Ir; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 

Pp, ppl : Tr; 
begin 

pp := begptr; 

pp1 := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:=0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
Pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 
pp2 := prev(pp1); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 


{ del2(pp1);} 


end; 
end; 


begin 
cirscr; 
add(2); 
add(10); 
add(5); 
add(1); 
add(7); 
add(11); 
writeln ^); 
show; 
del(1); 
writeln(delete position number 1"); 
show; 
del); 
writeln(delete position number 3'); 
show; 
del(4); 
writeln('delete position number 4"); 
show; 
end. 
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4 
1 
3 
1 
1 


1 
de lete position number 1 
14 


11 
delete position number 3 
1 


ِ 
11 
ا‎ position number 4 


5 
2 


المثال السادس 
القائمة معطاة اعمل على ترتيب العناصر في القائمة ومن ثم اعمل اضافة العنصر الذي تريدة في 
المكان الذي تريدة واحذف العنصر الذي تريدة من مكانة . 


البرنامج 


uses crt; 
type 
Tr=?r; 
r = record 
i : integer; 
next : TT; 
end; 
var 
1 : integer; 
begptr, endptr, pp : Tr; 


function find place(p!l : integer) : Tr; 
var 


Pp, ppl : Tr; 
ind : integer; 
begin 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
{ ppl := endptr; { 
ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 


pp^.next := begptr; 


begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 


pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : Ir; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


Var 
Ppp, ppl : Tr; 
begin 
pp := begptr; 
ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 


begin 
ppl := pp; 
break; 
end; 
Pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
1f pp1 = endptr then 
begin 


pp2 := prev(ppl1); 

pp2^.next := nil; 

dispose(endptr); 

endptr := pp2; 
end 


else 

begin 
pp2 := prev(pp1); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 
end; 


procedure sort; 

var 
st:string; 
x_beg, x h, x left, x left o:1nteger; 
i,k,count:1inte ger; 


pp;p,pl,p2: Tr; 
begin 
new(pP); 
pp^.next := begptr; {for sorting needed first dummy element } 
begptr := pp; fafter sorting we will delete this dummy element} 


p:=begptr^.next; 
count:=O0; 
while (p<>nil) do 
begin 
inc(count); 
p:=p^.next; 
end; 


for 1:=count downto 2 do 
begin 
k:=]; 


p:=begptr; 
while (k<1) do 
begin 
pl:=p^.next; 
p2:=p1^.next; 
if (p1^.1 > p2^.1) then 
begin 
p1^.next:=p2^.next; 
p2^.next:=pl; 
p^.next:=p2; 
if (p1^.next=nil) then 
endptr:=p1; 
end; 
p:=p^.next; 
inc(k); 
end; 
end; 


pp := begptr; 
begptr := begptr^.next; {delete dummy element} 
dispose(pp); 
end; 
begin 
cirscr; 
add(2,1); 
add(10,2); 
add(5,3); 
add(1,4); 
add(7,5); 
writeln ^); 
show; 
Sort; 
writeln(' sort element '); 
show; 
delG); 
writeln(' delete position number 3'); 


show; 
add(12,4); 
writeln( add in 4 position 12"); 
show; 
end. 
Î x G:\pascall TPIBIMIPX. EXE 
= 
1H 
51 
1 


sort elenment_ 


1 
۳ 
5 
7 
1 


1 
de lete position number 3 


ald in position number 4 al3adadl 12 


المثال السابع 
القائمة معطاة اوجد اكبر عدد في القائمة واصغرعدد في القائمة ومن ثم حذف اكبر عدد واصغر عدد 
واالاعداد التي تقع بين اكبر واصغر عدد في القائمة . 


البرنامج 


uses crt; 
type 
Tr=?^r; 
r = record 
i : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 


function find place(pl : integer) : Tr; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
pp! := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pPp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
{ ppl := endptr; { 
ppl := find); } 


pp1 := find place(place); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


var 
pp, ppl : Tr; 
begin 
pp := begptr; 


ppl := nil; 


while pp <> nil do 


begin 
1f pp^.next = p then 
begin 
ppl := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
pp! := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 
begin 


pp2 := prev(ppl); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 
pp2 := prev(ppl1); 
ppl := pp1^.next; 
dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 
end; 
procedure min max; 
var 
pp : Ir; 
1, max, 1i max, ind : integer; 
min, i min : integer; 
b, e : integer; 


begin 

pp := begptr; 

max := 0; 

min := begptr^.1; 

ind := 0; 

while pp <> nil do 

begin 
inc(ind); 
if (max < pp^.1) then 
begin 


max := pp^.1; 

1 _ max := ind; 
end; 
if (min > pp^.1) then 
begin 


min := pp^.1; 
i min := ind; 
end; 
pp := pp^.next; 
end; 


if1 max >1 min then 
begin 
b:=1 min; 
e:=1 max; 
end 
else 
begin 
b:=1 max; 
e :=1 min; 
end; 
writeln ^; 
writeln('max:=',max); 
writeln(min:=',min); 
for 1:=e downto b do 
del); 
end; 


begin 

cirscr; 
add(2,1); 
add(10,2); 
add(5,3); 
add(1,4); 
add(7,5); 
add(11,6); 


add(100,2); 


show; 
min max; 
writeln ^); 
show; 

end. 


if (max < pp^.1) then هنا نوجد اکبر عدد‎ 

begin 

اکبر عدد ;1.^مم =: ax‏ 

ال position‏ حق اکبر عدد ;dہ]‏ =: xھ_‏ 1 
end;‏ 
هنا نوجد اصغر عدد if (min > pp^.1) then‏ 
begin‏ 

اصغر عدد ;1. ٣مم‏ =: min‏ 

هنا نوجد 1t10۸ومم‏ حق اصغر عدد ;dم]‏ =: راص _1 
end;‏ 
يشير الى العنصر القادم pp := pp^.next;‏ 


هنا نوجد المكان الذي يقع بين اكبر واصغر عدد في القائمة 


اذا کان ٥٥!tزومم‏ اکبر عنصر اکبر من ۸٥1ا1ومماصغر‏ عنصر ifi _ max >i _ min then‏ 
begin‏ 

positionاصغر‏ عنصر ;1ص 1=: b‏ 

positionاكبر‏ عنصر ;×04 1=: 6 

end 

else 
begin 

positionاكبر‏ عنصر ;ز×4۾ص 1=: ا 

positionاصغر‏ عنصر ز11 1 =: 6 

end; 


for 1:=e downto b do 


نحذف ¡ التي هي اكبر واصغر عدد والاعداد التي بينهما del);‏ 
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المثال الثامن 


القائمة معطاة اوجد اكبر عنصر فيها ومن ثم اعمل على تقسيم القائمة الى قائمتين 
ا من ارل تخر آل ھا قل اکر غنضر و گان قدا من اکر عضر ال اکر ع 


البرنامج 


uses crt; 
type 
Tr=?^r; 
r = record 
i : integer; 
next : TT; 
end; 
var 
i : integer; 


begptr, endptr, pp : Tr; 
list1 begptr, listl1 endptr : Tr; 
list2 begptr, list2 endptr : Tr; 


function find place(pl : integer) : Tr; 
var 
Ppp, ppl : Tr; 
ind : integer; 
begin 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 

pp, ppl : Tr; 
begin 

new (PP); 

pp^.1 := 1; 

pp^.next := nil; 

if endptr = nil then 


begin 
endptr := pp; 
begptr := pp; 


end 


else 
begin 
{ ppl := endptr; { 
ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 
Pp, ppl : Tr; 


begin 


pp := begptr; 
ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 
var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1i:=1+1; 
ppl := pp; 
pp := pp^.next; 
if 1 = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 


if pp1 = endptr then 
begin 
pp2 := prev(pp1); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 
end; 


procedure max_ split; 

var 
pp : I1; 
1, max, i max, ind : integer; 
min, i min : integer; 
pp_prev, p_prev, p_max : Tr; 
b, e : integer; 


begin 
pp := begptr; 
max := 0; 
min := begptr^.1; 
ind := 0; 


p_prev := begptr; 
p_max := nil; 
while pp <> nil do 
begin 


inc(ind); 
if (max < pp^.1) then 
begin 
max := pp^.1; 
1 _ max := ind; 
p_prev := pp_prev; 


p_max := pp; 
end; 
Pp_prev :~ pp; 
pp := pp^.next; 
end; 
writeln; 


writeln(MAX:', p_ max^.1); 


list1 begptr := begptr; 
list1 endptr := p_ prev; 
list1 endptr^.next := nil; 


list2 begptr := p_ max; 
list2 endptr := endptr; 
list2 endptr^.next := nil; 
writeln(  listl "); 

pp := listl1 begptr; 
while pp <> nil do 


begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 


writeln(_ list2 ^; 
pp := list2 begptr; 
while pp <> nil do 


begin 
writeln(pp^.1); 
pp := pp^.next; 


end; 


end; 


begin 
cirscr; 
add(2,1); 
add(10,2); 
add(5,3); 
add(1,4); 
add(7,5); 
add(11,6); 
add(100,4); 
show; 
max_ split; 
writeln  '); 


end. 


نوجد اکبر عنصر ۸ع طا if (max < pp^.1(‏ 
begin‏ 
اکبر عنصر ;1. ٣مم‏ =: ax‏ 
مكان اكبر عنصر ;لہا =: ×جمط 1 
العنصر الذي قبل اكبر عنصر ۷ع۲م_م 
العنصر الاخير في القائمة ۷اع۲م_مpم‏ 
العنصر الاخير في القائمة = العنصر الذي قبل اكبر عنصر 
p_prev := pp_prev;‏ 
اکبر عنصر عملنا لة بريسفايفانيا ;مم =: ×ھ٣٥_م‏ 
end;‏ 
العنصر الاخير في القائمةpم‏ =: pp_prev‏ 
يوشر الى العنصر القادم ;×٥۸.*^مم‏ =: مم 
end;‏ 


writeln; 
writeln((MAX:', p_4x^.1); اظهار اكبر عنصر‎ 


في القائمة الاولى نضع فيها من بداي القائمة الرئيسية list1_begptr := begptr;‏ 
نضع في القائمة الاولى الى ما قبل اكبر عنصر ev;jإp_p‏ =: listl1_endp(r‏ 
نعمل عملية التصفير نجعل النهاية تشير الى الصفر list1 endptr^.next := nil;‏ 


في القائمة الثانية نضع فيها في البداية اكبر عنصر حيثما توقغنا list2_begptr := p_ax;‏ 
حتى النهاية الى اخر ieصر list2_ endptr := endptr;‏ 
نعمل عملية التصفير نجعل النهاية تشير الى الصفر list2 endptr^.next := nil;‏ 
writeln(  listl 1);‏ 
القائمة الاولى نرميها الى المتغير من نفس النوع pp := list1_ begprj;j pp‏ 
نفحص فيما اذا كانت القائمة فاضية او لا 0ل اام <> pصضp while‏ 
begin‏ 
نعمل على اظهار القائمة الاولى writeln(pp^.1);‏ 
من اجل ان يشير الى العناصر التالية في القائمة الاولى ويعمل على اظهار ها ;)×عہ.*مم =: مم 
كاملة 
end;‏ 
writeln( list2 ’);‏ 
القائمة الثانية الى المتغير من نفس النوع pp := list2 begprj;j pp‏ 
نفحص فيما اذا كانت القائمة فاضية او لا 0ل نہ <> صم while‏ 
begin‏ 
نعمل على اظهار القائمة الثانية:(p*.1م),1ع W1!)‏ 


من اجل ان يشير الى العناصر التالية في القائمة الثانية ويعمل على اظهار ها ;)×عہ. ٣مم‏ =: مم 
كاملة 
end;‏ 


2| Gi\lpascall TPIBIMITPX. EXE 


المثال التاسع 
القائمة معطاة احذف من القائمة الاعداد التي تقبل القسمة على ثلاثة وسبعة وضع في مكانها 
العدد 777. 
البرنامج 


uses crt; 
type 
Tr=?^y; 
r = record 
i : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 
function find place(p!l : integer) : Tr; 
var 


Pp, ppl : Tr; 
ind : integer; 
begin 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
{ ppl := endptr; { 
ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 


pp^.next := begptr; 


begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 


pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : Ir; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


Var 
Ppp, ppl : Tr; 
begin 
pp := begptr; 
ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 


begin 
ppl := pp; 
break; 
end; 
Pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
1f pp1 = endptr then 
begin 


pp2 := prev(ppl1); 

pp2^.next := nil; 

dispose(endptr); 

endptr := pp2; 
end 


else 

begin 
pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 


end; 


procedure edit; 
var 
pp : I1; 
i, count : integer; 
begin 
pp := begptr; 
count := 0; 
while pp <> nil do 
begin 
inc(count); 
pp := pp^.next; 
end; 
writeln('count:', count); 


for 1:=1 to count do 
begin 
pp := find place); 
if (pp^.i mod 3 = 0) or (pp^.1 mod 7 = 0) then 
begin 
del(i-1); 
add(777, 1-1); 
end; 


end; 


writeln ^; 

pp := begptr; 

while pp <> nil do 

begin 
writeln(pp^.1); 
pp := pp^.next; 

end; 


end; 


begin 
cirscr; 
add(7,1); 
add(10,2); 
add(3,3); 
add(1,4); 
add(21,5); 
add(22,6); 
add(33,7); 
add(42,8); 
add(88,9); 
writeln ^); 
show; 
edit; 
writeln ^); 


end. 


بداية القائمة ;٣)مع٥b‏ =: pp‏ 
من اجل نوجد كمية الاعداد ;0 =: 0u‏ 


نفحص فيما اذا كانت القائمة فاضية 0ل 1زم <> مم ازس 
begin‏ 

كمية العناصر ;(011ء)c٥,1‏ 

من اجل يشير الى العناصر القادمة ;)×ع١.*مم‏ =: مم 
end;‏ 
اظھار الكمية writeln(count:', count);‏ 


نعمل الحلقة على حسب الكمية for 1:=1 to count d0‏ 
begin‏ 
اوجدنا مكان العنصر pp := find place(i);‏ 
الاعداد التي تقبل القسمة على 3 او على 7 
if (pp^.i mod 3 = 0) or (pp^.1 mod 7 = 0) then‏ 
begin‏ 
نحذف مكان العنصر ;(1)1-1ءل 
ونضع في مكان العنصر العدد 777 ;(1-1 44d)777,‏ 
end;‏ 
end;‏ 


writeln('_ ");‏ 
من بداية القائمة ;امعط =: pp‏ 
نفحص فيما اذا كانت القائمة فاضية 0ل انم << صض while‏ 
begin‏ 
نعمل على اظهار النتيجة write1n(pp^.1(;‏ 
من اجل ان يشير الى العناصر القادمة وتظهر كاملة ;)×عہ.*مم =: مم 
end;‏ 


e" | GMpascal TPIBIMIPX. EXE 


المثال العاشر 


القائمة معطاة قم بتقسيم القائمة الى تلاثة اقسام القسم الاول من البداية الى ما قبل اصغر عدد والقسم 
الثاني يبدا من اصغر عدد الى ما قبل اكبر عدد والقسم الثالث يبدا من اكبر عدد الى النهاية. 


البرنامج 


uses crt; 
type 
Tr=?^y; 
r = record 
i : integer; 
next : TT; 
end; 
var 
i : integer; 
begptr, endptr, pp : Tr; 
list1 begptr, listl1 endptr : Tr; 
list2 begptr, list2 endptr : Tr; 


list3 begptr, list3 endptr : Tr; 


function find place(pl : Integer) : Tr; 
var 
Ppp, ppl : Tr; 
ind : integer; 
begin 
ppl := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
1f pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 
Pp, ppl : Tr; 
begin 
new (pp); 
pp^.1 := 1; 
pp^.next := nil; 
if endptr = nil then 
begin 
endptr := pp; 
begptr := pp; 
end 
else 
begin 
{ ppl := endptr; { 


ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 


var 
pp, ppl : Tr; 
begin 
pp := begptr; 


ppl := nil; 


while pp <> nil do 


begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 


var 
Pp, ppl, pp2 : Ir; 
1 : integer; 
begin 
pp := begptr; 
1:= 0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
pp := pp^.next; 
if 1 = ind then 
begin 
if pp1 = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
1f pp1 = endptr then 
begin 


pp2 := prev(pp1); 


pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(ppl); 
ppl := pp1^.next; 


dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(ppl);} 
end; 
end; 


procedure max_ split; 
var 
pp : I1; 
1, max, i max, ind : integer; 
min, i min : integer; 
pp_prev, p_prev, p_max, p_min, p_prev2 : Tr; 
b, e : integer; 


begin 
pp := begptr; 
max := 0; 
min := begptr^.1; 
ind := 0; 


p_prev := begptr; 
p_max := nil; 
while pp <> nil do 
begin 
inc(ind); 
if (max < pp^.1) then 
begin 


max := pp^.1; 
1 _ max := ind; 
p_prev := pp_ prev; 


p_max := pp; 
end; 


if (min > pp^.1) then 
begin 
min := pp^.1; 
1i min := ind; 
p_prev2 := pp_prev; 


p_min := pp; 
end; 
pp_prev := pp, 
pp := pp^.next; 
end; 


{ writeln(MAX:', p_max^.i);} 


list1 begptr := begptr; 
list1 endptr := p_prev2; 
list1 endptr^.next := nil; 


list2 begptr := p_min; 
list2 endptr := p_ prev; 
list2 endptr^.next := nil; 


list3 begptr := p_ max; 
list3 endptr := endptr; 
list3 endptr^.next := nil; 


writeln(  listl '); 
pp := listl1 begptr; 
while pp <> nil do 
begin 


writeln(pp^.1); 


pp := pp^.next; 
end; 


writeln(_ list2 ^; 
pp := list2 begptr; 
while pp <> nil do 


begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 


writeln(_ list ^; 
pp := list3_begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 

end; 

end; 

begin 
cirscr; 
add(2,1); 
add(10,2); 
add(1,3); 
add(5,4); 
add(7,5); 
add(11,6); 
add(100,5); 
writeln_ ©; 
show; 
writeln ©; 
writeln(altaqsim:'); 
max_ split; 


end. 


شرحها تقريبا نفس البرنامج رقم8 


2| G:\lpascall TPIBIMITPX. EXE 


المثال الحاد ي عشر 


قائمتين معطاة اعمل علی دمج القائمتين مع بعض. 


البرنامج 


uses crt; 
type 
Ir=Ag, 
r = record 
1 : integer; 
next : TT; 
end; 
var 
i : integer; 


begptr, endptr, pp : Tr; 
list1 begptr, listl1 endptr : Tr; 
list2 begptr, list2 endptr : Tr; 


function find place(pl : Integer) : Tr; 
var 
Pp, ppl : Tr; 
ind : integer; 
begin 
pp1 := nil; 
pp := begptr; 
ind := 0; 
while pp <> nil do 
begin 
inc(ind); 
if pl = ind then 
break; 
ppl := pp; 
pp := pp^.next; 
end; 
find place := ppl; 
end; 


procedure add( 1 : integer; place : integer ); 
var 

pp, ppl : Tr; 
begin 

new (pp); 

pPp^.1 := 1; 

pp^.next := nil; 

if endptr = nil then 


begin 
endptr := pp; 
begptr := pp; 
end 


else 


begin 
{ ppl := endptr; { 
ppl := find); } 
pp1 := find place(place); 
if pp1 = nil then 
begin 
pp^.next := begptr; 
begptr := pp; 
end 
else 
begin 
if pp1^.next = nil then 
endptr := pp; 
pp^.next := pp1^.next; 
pp1^.next := pp; 
end; 
end; 
end; 


procedure show; 


var 
pp : I1; 
begin 
pp := begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 
end; 


function prev(p : Tr) : Tr; 
var 


pp, ppl : Tr; 
begin 


pp := begptr; 
ppl := nil; 


while pp <> nil do 
begin 
if pp^.next = p then 
begin 
pp! := pp; 
break; 
end; 
pp := pp^.next; 
end; 
prev := ppl; 
end; 


procedure del(ind : integer); 
var 
pp, ppl, pp2 : Tr; 
1 : Integer; 
begin 
pp := begptr; 
1:=0; 
while pp <> nil do 
begin 
1:=1+1; 
ppl := pp; 
pp := pp^.next; 
if i = ind then 
begin 
if ppl = begptr then 
begin 
begptr := begptr^.next; 
dispose(pp1); 
end 
else 
if pp1 = endptr then 


begin 


pp2 := prev(ppl); 
pp2^.next := nil; 


dispose(endptr); 
endptr := pp2; 
end 
else 
begin 


pp2 := prev(pp1); 
ppl := pp1^.next; 
dispose(pp2^.next); 
pp2^.next := ppl; 
end; 
exit; 
end; 
{ del2(pp1);} 
end; 
end; 


begin 
cirscr; 
add(2,1); 
add(10,2); 
add(1,3); 
add(5,4); 
list1 begptr := begptr; 
list1 endptr := endptr; 
begptr := nil; 
endptr := nıl; 


add(7,5); 
add(11,6); 


add(100,5); 
list2 begptr := begptr; 
list2 endptr := endptr; 


writeln(  listl 1"); 
pp := listl begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 


writeln(  list2 "); 
pp := list2 begptr; 
while pp <> nil do 
begin 
writeln(pp^.1); 
pp := pp^.next; 
end; 


begptr := nil; 
endptr := nil; 
writeln; 
writeln(' ete7ad listl+list2: ’; 
begptr := listl1 begptr; 
list1 endptr^.next := list2 begptr; 
endptr := list2 endptr; 
show; 
writeln '); 
end. 


e" | G:lpascal TPIBIMIPX. EXE 


etefad listlrtlista: 


4 
1 
1 
5 


تصفية الشاشة زإیإ1إاC‏ 


اضافةالعناصر الى القائمة الارلى حسب المكان position‏ 

add(2,1); 

add(10,2); 

add(1,3); 

add(5,4); 

list1 begptr := begptr; بداية القائمة الاولى‎ 

list1 endptr := endptr; نهاية القائمة الثانية‎ 
begptr := nil; نصفر البدایة‎ 

endptr := ni1;يlنلاl نصفر‎ 


اضافةالعناصر الى القائمة الثانية حسب المكان ٣0ازوهم‏ 
add(7,5);‏ 
add(11,6);‏ 


add(100,5); 
list2 begptr := begptr; ةينlûلا بداية القائمة‎ 
list2 endptr := endptr; نهاية القائمة الثانية‎ 


هنا تخل على اظهار اضر القامة الول 
writeln( listl ’;‏ 
من pp := list1_begptr; lll‏ 
نفحص فيما اذا كانت القائمة فاضية ام لا 0ل انم <>< pصضp while‏ 
begin‏ 
هنا نعمل على اظهار عناصر القائمة الاولی ;(1. p^‏ م),1ع W1)‏ 
اظهار العناصر المتبقية في القائمة الاولى ;)×عم.*مم =: مم 
end;‏ 


فا ا و 
writeln(  list2 ’;‏ 
من llبدılة pp := list2_ begptr;‏ 
نفحص فيما اذا كانت القائمة فاضية ام لا 0ل 1نم <>< while pp‏ 
begin‏ 
هنا نعمل على اظهار عناصر القائمة الثانية:(1.٣pم),1ع w٤‏ 
اظهار العناصر المتبقية في القائمة الثانية)×عم. ٣مم‏ =: مم 
end;‏ 


begptr := nil; نصفر البداية‎ 

endptr := ni1;يlنلاl نصفر‎ 

writeln; 

writeln(' ete7ad listl+list2: ’; 


في القائمة الرئيسيةالجديدة في بدايتها نضع بداية القائمة الاولى 
begptr := listl1 begptr;‏ 

و ا لاضن الفادمة من اة الا اة 
list1 endptr^.next := list2 begptr;‏ 

في نهاية القائمة الجديدة ندخل نهاية القائمة الثانية 
endptr := list2 endptr;‏ 


وفي الاخير دعواتكم عبد الماجد الخليدي 
روسيا الاتحادية - روستوف نادانو 


